home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
boost4.arc
/
BOSHARE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1988-10-23
|
11KB
|
378 lines
{ - - - - - - - - - - - - - - - - - - - - - - - - - - }
{ B O O S T E R S }
{ Assembly Language Power }
{ for }
{ Turbo Pascal 4.0 Programmers }
{ Shareware Version 4.0 }
{ }
{ Copyright (C) 1985, 1986, 1987, 1988 }
{ George F. Smith & Company }
{ 609 Candlewick Lane }
{ Lilburn, GA 30247 }
{ (404) 923-6879 }
{ All Rights Reserved }
{ }
{ If you like Boosters, please register }
{ for $18.90. Or, if you prefer, you may }
{ order the complete library from the above }
{ address (check, VISA/MC). }
{ * with documentation on disk ... $25 }
{ * with printed manual .......... $35 }
{ * with printed manual & }
{ assembler source ............. $50 }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - }
unit BOSHARE;
INTERFACE
uses Dos, Crt;
Type
HeapBuf = ^AnyBuf;
AnyBuf = record
Screen : array[1..4000] of byte;
end;
Const
h = 'H'; { horizontal screen writes }
v = 'V'; { vertical screen writes }
Var
HeapTop : ^integer;
HPage : HeapBuf;
Regs : registers; { Defined in Dos unit }
VideoStatus : byte absolute $0040:$0049; { = 7 monochrome adapter }
{ <> 7 graphics adapter }
VideoSeg : word; { = $B000 for monochrome }
{ = $B800 for graphics }
SnowRemoval : Boolean; { = TRUE, routines will remove }
{ snow (intended for }
{ old CGAs). }
{ = FALSE, routines will access}
{ video w/o checking }
{ for snow. }
{ Time and date variables for Fstamp }
Filehh, Filemin, Filesec,
Fileyy, Filemm, Filedd,
{ Variables for Timer and Wait }
TimeElapsed,
SaveElapsed,
DTASeg, DTAOfs : Integer;
FileSpec,
FileName,
CurPath,
Path : String;
SubDirFlag,
StartElapsed : Boolean;
procedure Box (x1, y1, x2, y2, style, att : integer );
procedure Boxheap ( Hpage : heapbuf; x1, y1, x2, y2, style, att : integer );
procedure Cblkheap ( Hpage : heapbuf; x1,y1,x2,y2,x3,y3 : integer);
function Center ( S : String; Width : integer; Pad : char ) : String;
procedure ChgAtt ( x1, y1, x2, y2 : integer; FromAtt, ToAtt : byte );
function Cntch ( S : String; C : char ) : integer;
function Copies ( C : char; N : integer ) : String;
procedure CopyBlk ( x1,y1,x2,y2,x3,y3 : integer );
procedure CopyHeap ( FromPage, ToPage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
function CopyStr ( S : String; n : integer ) : String;
procedure CtrScr ( nsew : char; s : String; len, x, y : integer;
att : byte );
procedure DiffOne ( EW : char );
procedure Disk2Mem ( FileDesc : String; Num : integer;
Hpage : HeapBuf; var Ecode : integer );
function Dows ( month, day, year : integer ) : String;
function Dow ( month, day, year : integer ) : integer;
function DriveCnt : integer;
procedure Fil2Heap ( FileDesc : String; FromScreen, ToScreen : integer;
Hpage : HeapBuf; var Ecode : integer );
procedure FillHeap ( Hpage : Heapbuf; x1,y1,x2,y2 : integer;
ch : char; att : byte );
procedure FindStr ( x,y : integer; s : String; offset : integer;
var Ecode : integer );
procedure FstrHeap ( Hpage : HeapBuf; s : String; var x, y, ecode : integer );
function GchaHeap ( Hpage : HeapBuf; x, y : integer ) : integer;
function GetAtt ( x, y : integer ) : byte;
function GetChar ( x, y : integer ) : Char;
procedure GetHeap ( Hpage : HeapBuf; hv : char; S : String;
x, y, len : integer );
procedure GetStr ( hv : char; S : String; x, y : integer; len : byte );
procedure Heap2Scr ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer);
procedure HeapAtt ( Hpage : HeapBuf; x1,y1,x2,y2 : integer; att : byte );
function Hex ( DecimalValue : word ) : String;
procedure Input ( x, y : integer; Filter : String; var Data : String;
var LastCh : char; att : byte );
procedure Input2 ( x, y : integer; Filter : String; var Data : String;
var LastCh : char; att : byte );
function LastPos ( Needle, HayStack : String; Start : integer ) : integer;
function Left ( S : String; Width : Integer; Pad : Char ) : String;
function Lower ( S : String ) : String;
procedure MblkHeap ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
procedure MoveBg ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer);
procedure MoveBlk ( x1,y1,x2,y2,x3,y3 : integer );
procedure MoveBlkr ( x1,y1,x2,y2,x3,y3 : integer; att : byte );
function OverStr ( New, Target : String; N, Len : Integer;
Pad : Char ) : String;
procedure PchaHeap ( Hpage : HeapBuf; AttCh, x, y : integer );
procedure Pdq ( nsew : char; S : String; x, y : integer; att : byte );
function PosR ( Needle, HayStack : String; Start : integer ) : Integer;
procedure PutHeap ( Hpage : HeapBuf; hv : char; S : String; x,y : integer;
att : byte );
procedure PutStr ( hv : char; S : String; x, y : integer; att : byte );
procedure RemBlk ( x1, y1, x2, y2 : integer );
procedure RemBlkR ( x1, y1, x2, y2 : integer; att : byte );
procedure RestoreScreen ( Hpage : HeapBuf );
function Right ( S : String; Width : Integer; Pad : Char ) : String;
function Rword ( StrA : String; N : integer; StrB : String ) : String;
procedure SaveScreen ( Hpage : HeapBuf );
procedure Scr2Disk ( FileDesc : String; ScreenNumber : integer;
var Ecode : integer );
procedure Scr2Heap ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
procedure SetAtt ( x1, y1, x2, y2 : integer; att : byte );
function Space ( S : String; N : integer; Pad : Char ) : String;
function Strip ( S : String; Pad : Char ) : String;
function Stripr ( S : String; option , pad : char ) : String;
function SubWord ( S : String; N, NumWords : integer ) : String;
function translate ( S, InTable, OutTable : String; Pad : Char ) : String;
function Upper ( S : String ) : String;
function Verify ( S, Reference : String; Start : Integer ) : Integer;
function WordInd ( S : String; N : Integer ) : Integer;
function Wordn ( S : String; n : integer ) : String;
function WordPos ( Needle, Haystack : String; Start,
IgnoreSpaces : Integer ) : Integer;
function Words ( S : String ) : integer;
IMPLEMENTATION
{ - - - - - - - - - - - - - - - - - - - -
E X T E R N A L S
- - - - - - - - - - - - - - - - - - - - }
{$L BOX}
procedure Box; external;
{$L BOXHEAP}
procedure Boxheap; external;
{$L CBLKHEAP}
procedure Cblkheap; external;
{$L CENTER}
function Center; external;
{$L CHGATT}
procedure ChgAtt; external;
{$L CNTCH}
function Cntch; external;
{$L COPIES}
function Copies; external;
{$L COPYBLK}
procedure Copyblk; external;
{$L COPYHEAP}
procedure CopyHeap; external;
{$L COPYSTR}
function Copystr; external;
{$L CTRSCR}
procedure Ctrscr; external;
{$L DIFFONE}
procedure Diffone; external;
{$L DISK2MEM}
procedure Disk2Mem; external;
{$L DOW}
function Dow; external;
{$L DOWS}
function Dows; external;
{$L DRIVECNT}
function Drivecnt; external;
{$L FIL2HEAP}
procedure Fil2Heap; external;
{$L FILLHEAP}
procedure Fillheap; external;
{$L FINDSTR}
procedure Findstr; external;
{$L FSTRHEAP}
procedure Fstrheap; external;
{$L GCHAHEAP}
function GchaHeap; external;
{$L GETATT}
function Getatt; external;
{$L GETCHAR}
function Getchar; external;
{$L GETHEAP}
procedure Getheap; external;
{$L GETSTR}
procedure Getstr; external;
{$L HEAP2SCR}
procedure Heap2scr; external;
{$L HEAPATT}
procedure Heapatt; external;
{$L HEX}
function Hex; external;
{$L INPUT}
procedure Input; external;
{$L INPUT2}
procedure Input2; external;
{$L LASTPOS}
function Lastpos; external;
{$L LEFT}
function Left; external;
{$L LOWER}
function Lower; external;
{$L MBLKHEAP}
procedure MblkHeap; external;
{$L MOVEBG}
procedure Movebg; external;
{$L MOVEBLK}
procedure Moveblk; external;
{$L MOVEBLKR}
procedure Moveblkr; external;
{$L OVERSTR}
function OverStr; external;
{$L PCHAHEAP}
procedure PchaHeap; external;
{$L PDQ}
procedure Pdq; external;
{$L POSR}
function PosR; external;
{$L PUTHEAP}
procedure PutHeap; external;
{$L PUTSTR}
procedure Putstr; external;
{$L REMBLK}
procedure RemBlk; external;
{$L REMBLKR}
procedure RemBlkR; external;
{$L RESTORES}
procedure RestoreScreen; external;
{$L RIGHT}
function Right; external;
{$L RWORD}
function Rword; external;
{$L SAVES}
procedure SaveScreen; external;
{$L SCR2DISK}
procedure Scr2Disk; external;
{$L SCR2HEAP}
procedure Scr2Heap; external;
{$L SETATT}
procedure SetAtt; external;
{$L SPACE}
function Space; external;
{$L STRIP}
function Strip; external;
{$L STRIPR}
function Stripr; external;
{$L SUBWORD}
function SubWord; external;
{$L TRANSLATE}
function Translate; external;
{$L UPPER}
function Upper; external;
{$L VERIFY}
function Verify; external;
{$L WORDIND}
function WordInd; external;
{$L WORDN}
function Wordn; external;
{$L WORDPOS}
function WordPos; external;
{$L WORDS}
function Words; external;
BEGIN { initialization }
{ Set SnowRemoval flag and video memory segment address }
SnowRemoval := False;
if LastMode = 7 then
VideoSeg := $B000 { Monochrome }
else
VideoSeg := $B800; { Graphics }
{ StartElapsed is used by Timer.pas }
StartElapsed := False;
END. { Boosters 4.0 Shareware unit }